home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2001 May / SGI Freeware 2001 May - Disc 3.iso / dist / fw_expect.idb / usr / freeware / bin / rftp.z / rftp
Text File  |  1999-01-26  |  8KB  |  340 lines
  1. #!/usr/freeware/bin/expect -f
  2. # rftp - ftp a directory hierarchy (i.e. recursive ftp)
  3. # Version 2.10
  4. # Don Libes, NIST
  5. exp_version -exit 5.0
  6.  
  7. # rftp is much like ftp except that the command ~g copies everything in
  8. # the remote current working directory to the local current working
  9. # directory.  Similarly ~p copies in the reverse direction.  ~l just
  10. # lists the remote directories.
  11.  
  12. # rftp takes an argument of the host to ftp to.  Username and password
  13. # are prompted for.  Other ftp options can be set interactively at that
  14. # time.  If your local ftp understands .netrc, that is also used.
  15.  
  16. # ~/.rftprc is sourced after the user has logged in to the remote site
  17. # and other ftp commands may be sent at that time.  .rftprc may also be
  18. # used to override the following rftp defaults.  The lines should use
  19. # the same syntax as these:
  20.  
  21. set file_timeout 3600        ;# timeout (seconds) for retrieving files
  22. set timeout 1000000        ;# timeout (seconds) for other ftp dialogue
  23. set default_type binary        ;# default type, i.e., ascii, binary, tenex
  24. set binary {}            ;# files matching are transferred as binary
  25. set ascii {}            ;# as above, but as ascii
  26. set tenex {}            ;# as above, but as tenex
  27.  
  28. # The values of binary, ascii and tenex should be a list of (Tcl) regular
  29. # expressions.  For example, the following definitions would force files
  30. # ending in *.Z and *.tar to be transferred as binaries and everything else
  31. # as text.
  32.  
  33. # set default_type ascii
  34. # set binary {*.Z *.tar}
  35.  
  36. # If you are on a UNIX machine, you can probably safely ignore all of this
  37. # and transfer everything as "binary".
  38.  
  39. # The current implementation requires that the source host be able to
  40. # provide directory listings in UNIX format.  Hence, you cannot copy
  41. # from a VMS host (although you can copy to it).  In fact, there is no
  42. # standard for the output that ftp produces, and thus, ftps that differ
  43. # significantly from the ubiquitous UNIX implementation may not work
  44. # with rftp (at least, not without changing the scanning and parsing).
  45.  
  46. ####################end of documentation###############################
  47.  
  48. match_max -d 100000        ;# max size of a directory listing
  49.  
  50. # return name of file from one line of directory listing
  51. proc getname {line} {
  52.     # if it's a symbolic link, return local name
  53.     set i [lsearch $line "->"]
  54.     if {-1==$i} {
  55.          # not a sym link, return last token of line as name
  56.          return [lindex $line [expr [llength $line]-1]]
  57.     } else {
  58.          # sym link, return "a" of "a -> b"
  59.          return [lindex $line [expr $i-1]]
  60.     }
  61. }
  62.  
  63. proc putfile {name} {
  64.     global current_type default_type
  65.     global binary ascii tenex
  66.     global file_timeout
  67.  
  68.     switch -- $name    $binary    {set new_type binary} \
  69.             $ascii    {set new_type ascii} \
  70.             $tenex    {set new_type tenex} \
  71.             default    {set new_type $default_type}
  72.  
  73.     if {$current_type != $new_type} {
  74.         settype $new_type
  75.     }
  76.  
  77.     set timeout $file_timeout
  78.     send "put $name\r"
  79.     expect timeout {
  80.         send_user "ftp timed out in response to \"put $name\"\n"
  81.         exit
  82.     } "ftp>*"
  83. }
  84.  
  85. proc getfile {name} {
  86.     global current_type default_type
  87.     global binary ascii tenex
  88.     global file_timeout
  89.  
  90.     switch -- $name    $binary    {set new_type binary} \
  91.             $ascii    {set new_type ascii} \
  92.             $tenex    {set new_type tenex} \
  93.             default    {set new_type $default_type}
  94.  
  95.     if {$current_type != $new_type} {
  96.         settype $new_type
  97.     }
  98.  
  99.     set timeout $file_timeout
  100.     send "get $name\r"
  101.     expect timeout {
  102.         send_user "ftp timed out in response to \"get $name\"\n"
  103.         exit
  104.     } "ftp>*"
  105. }
  106.  
  107. # returns 1 if successful, 0 otherwise
  108. proc putdirectory {name} {
  109.     send "mkdir $name\r"
  110.     expect "550*denied*ftp>*" {
  111.         send_user "failed to make remote directory $name\n"
  112.         return 0
  113.     } timeout {
  114.         send_user "timed out on make remote directory $name\n"
  115.         return 0
  116.     } -re "(257|550.*exists).*ftp>.*"
  117.     # 550 is returned if directory already exists
  118.  
  119.     send "cd $name\r"
  120.     expect "550*ftp>*" {
  121.         send_user "failed to cd to remote directory $name\n"
  122.         return 0
  123.     } timeout {
  124.         send_user "timed out on cd to remote directory $name\n"
  125.         return 0
  126.     } -re "2(5|0)0.*ftp>.*"
  127.     # some ftp's return 200, some return 250
  128.  
  129.     send "lcd $name\r"
  130.     # hard to know what to look for, since my ftp doesn't return status
  131.     # codes.  It is evidentally very locale-dependent.
  132.     # So, assume success.
  133.     expect "ftp>*"
  134.     putcurdirectory
  135.     send "lcd ..\r"
  136.     expect "ftp>*"
  137.     send "cd ..\r"
  138.     expect timeout {
  139.         send_user "failed to cd to remote directory ..\n"
  140.         return 0
  141.     } -re "2(5|0)0.*ftp>.*"
  142.  
  143.     return 1
  144. }
  145.  
  146. # returns 1 if successful, 0 otherwise
  147. proc getdirectory {name transfer} {
  148.     send "cd $name\r"
  149.     # this can fail normally if it's a symbolic link, and we are just
  150.     # experimenting
  151.     expect "550*ftp>*" {
  152.         send_user "failed to cd to remote directory $name\n"
  153.         return 0
  154.     } timeout {
  155.         send_user "timed out on cd to remote directory $name\n"
  156.         return 0
  157.     } -re "2(5|0)0.*ftp>.*"
  158.     # some ftp's return 200, some return 250
  159.  
  160.     if $transfer {
  161.         send "!mkdir $name\r"
  162.         expect "denied*" return timeout return "ftp>"
  163.         send "lcd $name\r"
  164.         # hard to know what to look for, since my ftp doesn't return
  165.         # status codes.  It is evidentally very locale-dependent.
  166.         # So, assume success.
  167.         expect "ftp>*"
  168.     }
  169.     getcurdirectory $transfer
  170.     if $transfer {
  171.         send "lcd ..\r"
  172.         expect "ftp>*"
  173.     }
  174.     send "cd ..\r"
  175.     expect timeout {
  176.         send_user "failed to cd to remote directory ..\n"
  177.         return 0
  178.     } -re "2(5|0)0.*ftp>.*"
  179.  
  180.     return 1
  181. }
  182.  
  183. proc putentry {name type} {
  184.     switch -- $type \
  185.     d {
  186.         # directory
  187.         if {$name=="." || $name==".."} return
  188.         putdirectory $name
  189.     } - {
  190.         # file
  191.         putfile $name
  192.     } l {
  193.         # symlink, could be either file or directory
  194.         # first assume it's a directory
  195.         if [putdirectory $name] return
  196.         putfile $name
  197.     } default {
  198.         send_user "can't figure out what $name is, skipping\n"
  199.     }
  200. }
  201.  
  202. proc getentry {name type transfer} {
  203.     switch -- $type \
  204.     d {
  205.         # directory
  206.         getdirectory $name $transfer
  207.     } - {
  208.         # file
  209.         if !$transfer return
  210.         getfile $name
  211.     } l {
  212.         # symlink, could be either file or directory
  213.         # first assume it's a directory
  214.         if [getdirectory $name $transfer] return
  215.         if !$transfer return
  216.         getfile $name
  217.     } default {
  218.         send_user "can't figure out what $name is, skipping\n"
  219.     }
  220. }
  221.  
  222. proc putcurdirectory {} {
  223.     send "!/bin/ls -alg\r"
  224.     expect timeout {
  225.         send_user "failed to get directory listing\n"
  226.         return
  227.     } "ftp>*"
  228.  
  229.     set buf $expect_out(buffer)
  230.  
  231.     for {} 1 {} {
  232.         # if end of listing, succeeded!
  233.         if 0==[regexp "(\[^\n]*)\n(.*)" $buf dummy line buf] return
  234.  
  235.         set token [lindex $line 0]
  236.         switch -- $token \
  237.         !/bin/ls {
  238.             # original command
  239.         } total {
  240.             # directory header
  241.         } . {
  242.             # unreadable
  243.         } default {
  244.             # either file or directory
  245.             set name [getname $line]
  246.             set type [string index $line 0]
  247.             putentry $name $type
  248.         }
  249.     }
  250. }
  251.  
  252.  
  253. # look at result of "dir".  If transfer==1, get all files and directories
  254. proc getcurdirectory {transfer} {
  255.     send "dir\r"
  256.     expect timeout {
  257.         send_user "failed to get directory listing\n"
  258.         return
  259.     } "ftp>*"
  260.  
  261.     set buf $expect_out(buffer)
  262.  
  263.     for {} 1 {} {
  264.         regexp "(\[^\n]*)\n(.*)" $buf dummy line buf
  265.  
  266.         set token [lindex $line 0]
  267.         switch -- $token \
  268.         dir {
  269.             # original command
  270.         } 200 {
  271.             # command successful
  272.         } 150 {
  273.             # opening data connection
  274.         } total {
  275.             # directory header
  276.         } 226 {
  277.             # transfer complete, succeeded!
  278.             return
  279.         } ftp>* {
  280.             # next prompt, failed!
  281.             return
  282.         } . {
  283.             # unreadable
  284.         } default {
  285.             # either file or directory
  286.             set name [getname $line]
  287.             set type [string index $line 0]
  288.             getentry $name $type $transfer
  289.         }
  290.     }
  291. }
  292.  
  293. proc settype {t} {
  294.     global current_type
  295.  
  296.     send "type $t\r"
  297.     set current_type $t
  298.     expect "200*ftp>*"
  299. }
  300.  
  301. proc final_msg {} {
  302.     # write over the previous prompt with our message
  303.     send_user "\rQuit ftp or cd to another directory and press ~g, ~p, or ~l\n"
  304.     # and then reprompt
  305.     send_user "ftp> "
  306. }
  307.  
  308. if [file readable ~/.rftprc] {source ~/.rftprc}
  309. set first_time 1
  310.  
  311. if $argc>1 {
  312.     send_user "usage: rftp [host]"
  313.     exit
  314. }
  315.  
  316. send_user "Once logged in, cd to the directory to be transferred and press:\n"
  317. send_user "~p to put the current directory from the local to the remote host\n"
  318. send_user "~g to get the current directory from the remote host to the local host\n"
  319. send_user "~l to list the current directory from the remote host\n"
  320.  
  321. if $argc==0 {spawn ftp} else {spawn ftp $argv}
  322. interact -echo ~g {
  323.         if $first_time {
  324.             set first_time 0
  325.             settype $default_type
  326.         }
  327.         getcurdirectory 1
  328.         final_msg
  329. } -echo ~p {
  330.         if $first_time {
  331.             set first_time 0
  332.             settype $default_type
  333.         }
  334.         putcurdirectory
  335.         final_msg
  336. } -echo ~l {
  337.         getcurdirectory 0
  338.         final_msg
  339. }
  340.